Attribute VB_Name = "modSubClass"
Option Explicit

'API Declarations used for subclassing.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        pDest As Any, _
        pSrc As Any, _
        ByVal ByteLen As Long)

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
        ByVal lpPrevWndFunc As Long, _
        ByVal hWnd As Long, _
        ByVal msg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long

'Constants for GetWindowLong() and SetWindowLong() APIs.
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const WM_MOUSEWHEEL As Long = &H20A&

'Used to hold a reference to the control to call its procedure.
'NOTE: "UserControl1" is the UserControl.Name Property at
'      design-time of the .CTL file.
'      ('As Object' or 'As Control' does not work)
Dim ctlShadowControl As ListView

'Used as a pointer to the UserData section of a window.
Dim ptrObject As Long

'The address of this function is used for subclassing.
'Messages will be sent here and then forwarded to the
'UserControl's WindowProc function. The HWND determines
'to which control the message is sent.
Public Function SubWndProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
    ptrObject = GetWindowLong(hWnd, GWL_USERDATA)
    
    CopyMemory ctlShadowControl, ptrObject, 4
    
    SubWndProc = ctlShadowControl.WindowProc(hWnd, msg, wParam, lParam)
    
    CopyMemory ctlShadowControl, 0&, 4
    Set ctlShadowControl = Nothing
End Function

